home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tp_asm22.arc / TPA&OOP.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  10KB  |  307 lines
  1. {════════════════════════════════ TPA_OOP ════════════════════════════════}
  2. { Demonstrates TP&Asm support for Object Oriented Pascal, including:      }
  3. {                                                                         }
  4. { - Use of Assemble and Internal in method definitions                    }
  5. {   (Supports both "ObjectName@MethodName" and "ObjectName.MethodName")   }
  6. {                                                                         }
  7. { - Unqualified Indexed Reference to Object data within its methods       }
  8. {   (Unindexed Reference to Static Object data uses Pascal Record syntax) }
  9. {                                                                         }
  10. { - Automatic support for assembly references to "Self" and "VMT"         }
  11. {   (Freely change object structure without rewriting any assembly code!) }
  12. {                                                                         }
  13. { - Direct call to Static AND VIRTUAL methods using Unindexed MethodName  }
  14. {                                                                         }
  15. { - Standard virtual call to Virtual methods using Indexed MethodName     }
  16. {                                                                         }
  17. {=> Compile to Disk or Memory and Run.  Move HappyFace with cursor keys <=}
  18. {═════════════════════════════════════════════════════════════════════════}
  19. Program TPA_OOP;
  20.  
  21. TYPE
  22.  {- A ScreenCell is a Screen Location which can be Read or Written -}
  23.   ScreenCell = Object
  24.     X,Y: Byte;
  25.     procedure Init(InitX, InitY, InitAttr : Byte; InitSym: Char);
  26.     function GetDisplay : Word; 
  27.     procedure SetDisplay(NewContents : Word); 
  28.   end;
  29.  
  30.  {- An OccupiedCell is a ScreenCell which knows its current/prior contents -}
  31.   OccupiedCell = Object(ScreenCell)
  32.     Visible: Boolean;
  33.     Occupant,Occupied: Word;
  34.     constructor Init(InitX, InitY, InitAttr : Byte; InitSym: Char);
  35.     destructor Done;
  36.     Procedure Show; virtual;
  37.     Procedure Hide; virtual;
  38.     Procedure MoveRight; virtual;
  39.     Procedure MoveLeft; virtual;
  40.     Procedure MoveUp; virtual;
  41.     Procedure MoveDown; virtual;
  42.   end;
  43.  
  44.  
  45. PROCEDURE ScreenCell.Init(InitX, InitY, InitAttr : Byte; InitSym: Char);
  46. BEGIN
  47.   X := InitX;
  48.   Y := InitY;
  49.   SetDisplay( Byte(InitSym) OR (InitAttr SHL 8) );
  50. END; {PROCEDURE ScreenCell.Init;}
  51.  
  52.  
  53. Internal ScreenCellMethods
  54. CODE Segment
  55. ScreenCell@GetDisplay PROC FAR     ;or use "ScreenCell.GetDisplay"
  56.  
  57.   Self EQU D [Bp+6]   ;Internal/External statements must define "Self"
  58.  
  59.   Push Bp
  60.   Mov Bp,Sp
  61.  
  62.   Mov Ah,0F           ;get active page into Bh
  63.   Int 10h
  64.  
  65.   Les Di,Self         ;Load pointer to "Self"
  66.   Es Mov Dl,X[Di]     ;Indexed reference to ScreenCell.X
  67.   Dec Dl
  68.   Es Mov Dh,[Di+Y]    ;Indexed reference to ScreenCell.Y
  69.   Dec Dh
  70.   Mov Ah,02           ;set cursor position
  71.   Int 10h
  72.   Mov Ah,08           ;get char and attr into Ax
  73.   Int 10h             ; (leave function result in Ax)
  74.  
  75.   Pop Bp              ;No need to  Mov Sp,Bp
  76.   Ret 4               ;Remove "Self" parameter (using implied RetF)
  77.  
  78. ScreenCell@GetDisplay ENDP
  79.  
  80. CODE ENDS
  81.  
  82. End Internal ScreenCellMethods;
  83.  
  84.  
  85. Procedure ScreenCell.SetDisplay(NewContents : Word);
  86. BEGIN
  87.   Assembly
  88.     Mov Ah,0F         ;get active page into Bh
  89.     Int 10h
  90.     Les Di,Self       ;Assembly statements can reference "Self" parameter
  91.     Mov Dl,Es:X[Di]   ;Indexed reference to ScreenCell.X
  92.     Dec Dl
  93.     Mov Dh,Es:[Di+Y]  ;Indexed reference to ScreenCell.Y
  94.     Dec Dh
  95.     Mov Ah,02         ;set cursor position
  96.     Int 10h
  97.     Mov Ax,NewContents
  98.     Mov Bl,Ah         ;put attr in Bl
  99.     Mov Cx,1          ;count of bytes to write
  100.     Mov Ah,09         ;write char and attr
  101.     Int 10h
  102.   END; {Assembly}
  103.   {- Standard Procedure exit code will code the required Retf 6 -}
  104. END; {Procedure ScreenCell.SetDisplay}
  105.  
  106.  
  107.  
  108. constructor OccupiedCell.Init(InitX, InitY, InitAttr : Byte; InitSym: Char);
  109. BEGIN
  110.  {- Code part in assembly to avoid unnecessarily reloading Es:Di -}
  111.   Assembly
  112.     Les Di,Self               ;Load pointer to Self
  113.     Es Mov Visible[Di],FALSE  ;- Visible := FALSE;
  114.  
  115.     Mov Al,InitX
  116.     Es Mov X[Di],Al           ;- X := InitX;
  117.  
  118.     Mov Al,InitY
  119.     Mov Es:[Di+Y],Al          ;- Y := InitY;
  120.  
  121.     Mov Al,InitSym
  122.     Mov Ah,InitAttr           ;- Occupant := Byte(InitSym)
  123.     Mov Es:[Di]Occupant,Ax    ;-            OR (InitAttr SHL 8);
  124.  
  125.   END; {Assembly}
  126.  
  127.   Show;               {- Let Turbo handle this virtual Call         -}
  128.                       {- See MoveRight for an Assembly virtual call -}
  129.  
  130. END; {PROCEDURE ScreenCell.Init;}
  131.  
  132.  
  133. Procedure OccupiedCell.Show;
  134. BEGIN
  135.   IF NOT Visible THEN Assembly
  136.  
  137.     Les Di,Self               ;- Visible := TRUE;
  138.     Es Mov Visible[Di],TRUE
  139.  
  140.     Push Es,Di                ;Push "Self" parameter
  141.     Call GetDisplay           ;Direct Call to Static Method, result in Ax
  142.     Les Di,Self               ;Reload, most methods destroy Es:Di
  143.     Es Mov Occupied[Di],Ax    ;- Occupied := GetDisplay;
  144.  
  145.     Es Push Occupant[Di]      ;- SetDisplay(Occupant);
  146.     Push Es,Di                ;Push "Self" parameter
  147.     Call SetDisplay           ;Direct Call to Static Method
  148.  
  149.   END; {IF NOT Visible THEN }
  150. END; {Procedure OccupiedCell.Show}
  151.  
  152.  
  153. Internal OccupiedCellMethods;
  154. CODE Segment
  155. OccupiedCell.MoveRight PROC   ;or use "OccupiedCell@MoveRight"
  156.  
  157.   Self EQU D [Bp+6]           ;Internal/External statements must define "Self"
  158.  
  159.   Push Bp
  160.   Mov Bp,Sp
  161.  
  162.                               ;- Hide; (VMT call)
  163.   Les Di,Self                 ;Load "Self" pointer
  164.   Push Es,Di                  ;Pass as self parameter
  165.   Es Mov Di,VMT[Di]           ;Pick up VMT offset from VMT field
  166.   Call Hide[Di]               ;Indexed reference codes Virtual Call
  167.  
  168.   Les Di,Self                 ;Reload "Self" pointer
  169.   Es Cmp X[Di],80             ;- IF X<80
  170.   IF B Es Inc X[Di]           ;-  THEN Inc(X);
  171.  
  172.                               ;- Show; (VMT call)
  173.   Push Es,Di                  ;Es:[Di] is still valid
  174.   Mov Di,Es:[Di+VMT]          ;Pick up VMT offset from VMT field
  175.   Call [Di+Show]              ;Indexed reference codes Virtual Call
  176.  
  177.   Pop Bp                      ;No need to  Mov Sp,Bp
  178.   Ret 4                       ;Remove "Self" parameter
  179.  
  180. OccupiedCell.MoveRight ENDP
  181.  
  182.  
  183. OccupiedCell@MoveLeft PROC    ;or use "OccupiedCell.MoveLeft"
  184.  
  185.   Self EQU D [Bp+6]           ;Internal/External statements must define "Self"
  186.  
  187.   Push Bp
  188.   Mov Bp,Sp
  189.  
  190.                               ;- Hide; (Direct Call)
  191.   Les Di,Self                 ;Load "Self" pointer
  192.   Push Es,Di                  ;Pass as self parameter
  193.  ;--> Use an unindexed reference to code STATIC (Direct) Calls
  194.   Call OccupiedCell.Hide      ;STATIC (Direct) Call to virtual method
  195.  
  196.   Les Di,Self                 ;Reload "Self" pointer
  197.   Es Cmp X[Di],1              ;- IF X>1
  198.   IF A Es Dec X[Di]           ;-  THEN Dec(X);
  199.  
  200.                               ;- Show; (Direct Call)
  201.   Push Es,Di                  ;Es:[Di] is still valid
  202.   Call Show                   ;STATIC (Direct) Call to virtual method
  203.  
  204.   Pop Bp                      ;No need to  Mov Sp,Bp
  205.   Ret 4                       ;Remove "Self" parameter
  206.  
  207. OccupiedCell@MoveLeft ENDP
  208.  
  209. CODE ENDS
  210.  
  211. End Internal OccupiedCellMethods;
  212.  
  213.  
  214. {- Code remaining methods in Pascal -}
  215.  
  216. Procedure OccupiedCell.MoveUp;
  217. BEGIN
  218.   Hide;
  219.   IF Y>1 THEN Dec(Y);
  220.   Show;
  221. END; {Procedure OccupiedCell.MoveUp}
  222.  
  223. Procedure OccupiedCell.MoveDown;
  224. BEGIN
  225.   Hide;
  226.   IF Y<25 THEN Inc(Y);
  227.   Show;
  228. END; {Procedure OccupiedCell.MoveDown}
  229.  
  230. Procedure OccupiedCell.Hide;
  231. BEGIN
  232.   SetDisplay(Occupied);
  233.   Visible := FALSE;
  234. END; {Procedure OccupiedCell.Hide}
  235.  
  236. destructor OccupiedCell.Done;
  237. BEGIN
  238.   Hide;
  239. END; {destructor OccupiedCell.Done;}
  240.  
  241.  
  242. FUNCTION ReadScan: Byte; { Read keyboard scan code without echo to screen }
  243.  Assembly             {- Inline Directive -}
  244.   Mov Ah,0
  245.   Int 16h
  246.   Mov Al,Ah           ;Put Assembly/Inline Directive result in Al
  247.  END; {Assembly}
  248.  
  249. FUNCTION GetCursor: WORD;      { Get cursor position on active video page }
  250.  Assembly             {- Inline Directive -}
  251.   Mov Ah,0F           ;get active page into Bh
  252.   Int 10h
  253.   Mov Ah,03           ;get cursor position into Dx
  254.   Int 10h
  255.   Mov Ax,Dx           ;Put Assembly/Inline Directive result in Ax
  256.  END; {Assembly}
  257.  
  258. PROCEDURE RestoreCursor(SvPos: Word);     { Restore saved cursor position }
  259.  Assembly             {- Inline Directive -}
  260.   Mov Ah,0F           ;get active page into Bh
  261.   Int 10h
  262.   Pop Dx              ;Parameter to Assembly/Inline Directive
  263.   Mov Ah,02           ;set cursor position
  264.   Int 10h
  265.  END; {Assembly}
  266.  
  267.  
  268.  
  269. CONST {- Scan Codes of cursor and escape keys -}
  270.       UpArrow = $48;      RtArrow = $4D;      Escape  = $01;
  271.       DnArrow = $50;      LfArrow = $4B;
  272.  
  273. VAR
  274.   HappyFace: OccupiedCell;
  275.   MsgBlock: ARRAY[1..20] OF OccupiedCell;
  276.   n: Integer;
  277.   SavedCursor: WORD;
  278.  
  279. CONST
  280.   ExitMsg: STRING[20] = 'Press <Esc> to Exit';
  281.  
  282. BEGIN {MAIN}
  283.  
  284.   SavedCursor := GetCursor;
  285.  
  286.   FOR n := 1 TO Length(ExitMsg)
  287.    DO MsgBlock[n].Init(n+30,1,$87,ExitMsg[n]);
  288.  
  289.   HappyFace.Init(20,5,6,#2);
  290.  
  291.   WHILE TRUE
  292.   DO Case ReadScan OF
  293.     UpArrow: HappyFace.MoveUp;
  294.     DnArrow: HappyFace.MoveDown;
  295.     RtArrow: HappyFace.MoveRight;
  296.     LfArrow: HappyFace.MoveLeft;
  297.     Escape:  BEGIN
  298.                HappyFace.Done;
  299.                FOR n := 1 TO Length(ExitMsg)
  300.                 DO MsgBlock[n].Done;
  301.                RestoreCursor(SavedCursor);
  302.                Halt;
  303.              END;
  304.   END; {DO Case ReadScan }
  305.  
  306. END.
  307.